home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyRecordedMenuCommands.p < prev    next >
Encoding:
Text File  |  1997-03-19  |  3.4 KB  |  146 lines  |  [TEXT/CWIE]
  1. unit MyRecordedMenuCommands;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types, AppleEvents;
  7.     
  8.     type
  9.         RecordedEnabledProc = function:boolean;
  10.         RecordedActionProc = procedure;
  11.         
  12.     procedure StartupRecordedMenuCommands;
  13.     procedure SetRecordedMenuCommand( class_id, event_id: AEEventID; command: OSType; enabled: RecordedEnabledProc; action: RecordedActionProc );
  14.     
  15. implementation
  16.  
  17.     uses
  18.         Memory, Events, 
  19.         MyMemory, MyStartup, MyAssertions, MyFMenus, MyAEUtils, MyMenus, MySystemGlobals;
  20.     
  21.     type
  22.         EntryRecord = record
  23.             class_id, event_id: AEEventID;
  24.             command: OSType;
  25.             enabled: RecordedEnabledProc;
  26.             action: RecordedActionProc;
  27.         end;
  28.         EntryArray = array[1..10000] of EntryRecord;
  29.         EntryPtr = ^EntryArray;
  30.         EntryHandle = ^EntryPtr;
  31.  
  32. {$ifc do_debug}
  33.     var
  34.         startup_check: integer;
  35. {$endc}
  36.  
  37.     var
  38.         entries: EntryHandle;
  39.         entries_count: longint;
  40.         handler: AEEventHandlerUPP;
  41.     
  42.     procedure FindCommand( command: OSType; var index: longint );
  43.         var
  44.             i: integer;
  45.     begin
  46.         index := -1;
  47.         for i := 1 to entries_count do begin
  48.             if entries^^[i].command = command then begin
  49.                 index := i;
  50.                 leave;
  51.             end;
  52.         end;
  53.         Assert( index > 0 );
  54.     end;
  55.     
  56.     function IsIndexEnabled( index: integer ): boolean;
  57.         var
  58.             sigh: RecordedEnabledProc;
  59.     begin
  60.         sigh := entries^^[index].enabled;
  61.         IsIndexEnabled := sigh();
  62.     end;
  63.     
  64.     procedure DoIndexAction( index: integer );
  65.         var
  66.             sigh: RecordedActionProc;
  67.     begin
  68.         sigh := entries^^[index].action;
  69.         sigh();
  70.     end;
  71.     
  72.     function HandleShowTranscript (var event, reply: AppleEvent; index: longint): OSErr;
  73.     begin
  74. {$unused(event, reply)}
  75.         if IsIndexEnabled( index ) then begin
  76.             DoIndexAction( index );
  77.             HandleShowTranscript := noErr;
  78.         end else begin
  79.             HandleShowTranscript := -1;
  80.         end;
  81.     end;
  82.  
  83.     procedure DoAction;
  84.         var
  85.             index: longint;
  86.             command: OSType;
  87.     begin
  88.         GetCommand( thefmenu, thefitem, command );
  89.         FindCommand( command, index );
  90.         if has_AppleEvents then begin
  91.             SendSelfSimpleEvent( entries^^[index].class_id, entries^^[index].event_id );
  92.         end else if IsIndexEnabled( index ) then begin
  93.             DoIndexAction( index );
  94.         end;
  95.     end;
  96.     
  97.     procedure SetAction (themenu, theitem: integer);
  98.         var
  99.             index: longint;
  100.             command: OSType;
  101.     begin
  102.         GetCommand( themenu, theitem, command );
  103.         FindCommand( command, index );
  104.         SetIDItemEnable(themenu, theitem, entries^^[index].enabled() );
  105. {        SetIDItemEnable(themenu, theitem, IsIndexEnabled( index ) );}
  106.     end;
  107.  
  108.     procedure SetRecordedMenuCommand( class_id, event_id: AEEventID; command: OSType; enabled: RecordedEnabledProc; action: RecordedActionProc );
  109.         var
  110.             err: OSErr;
  111.             entry: EntryRecord;
  112.     begin
  113.         AssertDidStartup( startup_check );
  114.         entry.class_id := class_id;
  115.         entry.event_id := event_id;
  116.         entry.command := command;
  117.         entry.enabled := enabled;
  118.         entry.action := action;
  119.         err := PtrAndHand(@entry, Handle(entries), SizeOf(entry));
  120.         if err = noErr then begin
  121.             Inc(entries_count);
  122.             if has_AppleEvents then begin
  123.                 err := AEInstallEventHandler( class_id, event_id, handler, entries_count, false );
  124.             end;
  125.             SetFBoth( command, DoAction, SetAction );
  126.         end;
  127.     end;
  128.     
  129.     function InitRecordedMenuCommands( var msg: integer ): OSStatus;
  130.         var
  131.             err: OSStatus;
  132.     begin
  133. {$unused(msg)}
  134.         DidStartup( startup_check );
  135.         err := MNewHandle( entries, 0 );
  136.         handler := NewAEEventHandlerProc(HandleShowTranscript);
  137.         InitRecordedMenuCommands := noErr;
  138.     end;
  139.  
  140.     procedure StartupRecordedMenuCommands;
  141.     begin
  142.         SetStartup( InitRecordedMenuCommands, nil, 0, nil );
  143.     end;
  144.     
  145. end.
  146.